home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Dr. Windows 3
/
dr win3.zip
/
dr win3
/
VISUALBA
/
VBUTIL.ZIP
/
PSCRNLIB.BAS
< prev
next >
Wrap
BASIC Source File
|
1992-10-06
|
5KB
|
182 lines
Sub InitScreen (MaxRow%, MaxCol%, SD As ScreenType)
' initialize screen parameters
SD.MaxCols = MaxCol%
SD.MaxRows = MaxRow%
SD.CursX = 1
SD.CursY = 1
End Sub
Sub ClearScreen (TBox As Control, SL$(), SD As ScreenType)
' clear the screen by assigning empty strings to the
' TBox and SL$ array and setting the cursor variables to 1.
Dim I As Integer
If TypeOf TBox Is TextBox Then
TBox.Text = ""
For I = 1 To SD.MaxRows
SL$(I) = ""
Next I
SD.CursX = 1
SD.CursY = 1
End If
End Sub
Sub GotoXY (X%, Y%, SL$(), SD As ScreenType)
' move the hidden cursor to (X%, Y%)
Dim L As Integer
If (X% < 1) Or (Y% < 1) Then Exit Sub
If (Y% > SD.MaxRows) Or (X% > SD.MaxCols) Then Exit Sub
L = Len(SL$(Y%))
If X% > L Then
SL$(Y%) = SL$(Y%) + Space$(X% - L)
End If
SD.CursX = X%
SD.CursY = Y%
End Sub
Function WhereX (SD As ScreenType) As Integer
' return the value of SD.CursX
WhereX = SD.CursX
End Function
Function WhereY (SD As ScreenType) As Integer
' return the value of the SD.CursY
WhereY = SD.CursY
End Function
Sub ScrollUp (NumLines%, TBox As Control, SL$(), SD As ScreenType)
' scroll up a specified number of lines
Dim I As Integer
If TypeOf TBox Is TextBox Then
Else
Exit Sub
End If
If NumLines < 1 Then Exit Sub
' scroll at most SD.MaxRows
If NumLines > SD.MaxRows Then
NumLines = SD.MaxRows
End If
' copy leading string to emulate scroll
For I = 1 To SD.MaxRows - NumLines
SL$(I) = SL$(I + NumLines)
Next I
' assign empty string to trailing strings
For I = SD.MaxRows - NumLines + 1 To SD.MaxRows
SL$(I) = ""
Next I
UpdateScreenText TBox, SL$(), SD
End Sub
Sub NewLine (TBox As Control, SL$(), SD As ScreenType)
' move the hidden cursor to the first column of
' the next line. Scroll screen up if the cursor
' is already at the last allowed screen row
If TypeOf TBox Is TextBox Then
If SD.CursY < SD.MaxRows Then
SD.CursY = SD.CursY + 1
SD.CursX = 1
Else
ScrollUp 1, TBox, SL$(), SD
SD.CursX = 1
End If
End If
End Sub
Sub PPrint (S$, UpdateScreenNow%, TBox As Control, SL$(), SD As ScreenType)
' Emulate a simple form of the QuickBasic print:
'
' PRINT Astring$;
'
' The second parameter enable you to update the text
' on the screen, or keep the changes hidden (for now).
Dim LenStr As Integer
Dim LenLine As Integer
Dim LenDiff As Integer
Dim S2 As String
If TypeOf TBox Is TextBox Then
Else
Exit Sub
End If
If S$ = "" Then Exit Sub
LenStr = Len(S$)
If SD.CursY = SD.MaxRows Then ScrollUp 1
LenLine = Len(SL$(SD.CursY))
S2 = ""
' string cannot fit on the current line?
If (SD.CursX + LenStr) > SD.MaxCols Then
LenDiff = SD.CursX + LenStr - SD.MaxCols - 1
' split original string into two strings
S2 = Right$(S$, LenDiff) ' next-line text
S$ = Left$(S$, LenStr - LenDiff)
End If
' Pad current line
If (SD.CursX + LenStr) > LenLine Then
LenDiff = SD.CursX + LenStr - LenLine
SL$(SD.CursY) = SL$(SD.CursY) + Space$(LenDiff)
End If
' write S to current line
Mid$(SL$(SD.CursY), SD.CursX, LenStr) = S$
SD.CursX = SD.CursX + LenStr
' the next-line string is not empty?
If SD.CursX > SD.MaxCols Then NewLine TBox, SL$(), SD
If S2 <> "" Then ' print to the next line
If SD.CursY < SD.MaxCols Then NewLine TBox, SL$(), SD
LenDiff = Len(S2) - Len(SL$(SD.CursY))
If LenDiff > 0 Then ' pad the string for the next line
SL$(SD.CursY) = SL$(SD.CursY) + Space$(LenDiff)
End If
' write the next-line string
Mid$(SL$(SD.CursY), 1, Len(S2)) = S2
SD.CursX = Len(S2) + 1
If SD.CursX > SD.MaxCols Then NewLine TBox, SL$(), SD
End If
' update the screen now?
If UpdateScreenNow% Then UpdateScreenText TBox, SL$(), SD
End Sub
Sub SaveScreen (Buff$(), BufData As ScreenType, SL$(), SD As ScreenType)
' save screen to Buff$() array.
' the current position of the hidden cursor is
' stored in the fields of the SD parameter
Dim I As Integer
For I = 1 To SD.MaxRows
Buff$(I) = SL$(I)
Next I
BufData.MaxRows = SD.MaxRows
BufData.MaxCols = SD.MaxCols
BufData.CursX = SD.CursX
BufData.CursY = SD.CursY
End Sub
Sub LoadScreen (TBox As Control, Buff$(), BufData As ScreenType, SL$(), SD As
ScreenType)
' load screen from the Buff$() array
' the fields of the SD parameters specify new cursor location
Dim I As Integer
If TypeOf TBox Is TextBox Then
For I = 1 To SD.MaxRows
SL$(I) = Buff$(I)
Next I
SD.MaxRows = BufData.MaxRows
SD.MaxCols = BufData.MaxCols
SD.CursX = BufData.CursX
SD.CursY = BufData.CursY
UpdateScreenText TBox, SL$(), SD
End If
End Sub
Sub UpdateScreenText (TBox As Control, SL$(), SD As ScreenType)
' update the text in the TBox
Dim I As Integer
Dim S As String
Dim NL As String * 2
If TypeOf TBox Is TextBox Then
NL = Chr$(13) + Chr$(10)
S = ""
For I = 1 To SD.MaxRows - 1
S = S + SL$(I) + NL
Next I
S = S + SL$(SD.MaxRows)
TBox.Text = S
End If
End Sub